Syntax10.Scn.Fnt
StampElems
Alloc
19 Jul 95
Syntax10b.Scn.Fnt
MODULE FontElems;	(** HM 
IMPORT Viewers, Fonts, Texts, TextFrames, Oberon, PopupElems;
	Elem* = POINTER TO ElemDesc;
	ElemDesc* = RECORD (PopupElems.ElemDesc)
	END;
	ext: ARRAY 16 OF CHAR;
PROCEDURE SplitFont (name: ARRAY OF CHAR; VAR family, style: ARRAY OF CHAR; VAR size: INTEGER);
	VAR i: INTEGER;
BEGIN
	style[0] := 0X; size := 0; i := 0;
	WHILE (name[i] # 0X) & ((name[i] < "0") OR (name[i] > "9")) DO family[i] := name[i]; INC(i) END;
	family[i] := 0X;
	WHILE (name[i] # 0X) & (name[i] >= "0") & (name[i] <= "9") DO
		size := 10*size + ORD(name[i]) - ORD("0"); INC(i)
	END;
	IF (CAP(name[i]) = "I") OR (CAP(name[i]) = "B") THEN style[0] := name[i]; style[1] := 0X END
END SplitFont;
PROCEDURE MakeFont (family, style: ARRAY OF CHAR; size: INTEGER; VAR name: ARRAY OF CHAR);
	VAR i, j: INTEGER; d: ARRAY 5 OF CHAR; ch: CHAR;
BEGIN
	i := 0; WHILE family[i] # 0X DO name[i] := family[i]; INC(i) END;
	j := 0; REPEAT d[j] := CHR(size MOD 10 + ORD("0")); size := size DIV 10; INC(j) UNTIL size = 0;
	REPEAT DEC(j); name[i] := d[j]; INC(i) UNTIL j = 0;
	IF style # "" THEN name[i] := style[0]; INC(i) END;
	j := 0; REPEAT ch := ext[j]; name[i] := ch; INC(i); INC(j) UNTIL ch = 0X
END MakeFont;
PROCEDURE Change (t: Texts.Text; beg, end: LONGINT; family, style: ARRAY OF CHAR; size: INTEGER);
	VAR r: Texts.Reader; pos, org: LONGINT; ch: CHAR; fnt : Fonts.Font; fam, sty: ARRAY 32 OF CHAR; siz: INTEGER;
		name: ARRAY 64 OF CHAR;
BEGIN
	pos := beg; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
	WHILE pos < end DO
		org := pos; fnt := r.fnt;
		REPEAT INC(pos); Texts.Read(r, ch) UNTIL (pos >= end) OR (r.fnt # fnt);
		SplitFont(fnt.name, fam, sty, siz);
		IF family # "" THEN COPY(family, fam) END;
		IF (style = "b") OR (style = "i") THEN COPY(style, sty) ELSIF style = "p" THEN sty := "" END;
		IF size # 0 THEN siz := size END;
		MakeFont(fam, sty, siz, name); fnt := Fonts.This(name);
		IF (fnt # NIL) & (fnt.name = name) THEN Texts.ChangeLooks(t, org, pos, {0}, fnt, 0, 0) END
END Change;
PROCEDURE Exec (e: Elem; pos: LONGINT);
	VAR t: Texts.Text; s: Texts.Scanner; style, family: ARRAY 32 OF CHAR; size: INTEGER; beg, end, time: LONGINT;
BEGIN
	Oberon.GetSelection(t, beg, end, time);
	IF time >= 0 THEN
		style := ""; family := ""; size := 0;
		Texts.OpenScanner(s, e.menu, pos); Texts.Scan(s);
		IF (s.class IN {Texts.Name, Texts.String}) & (s.line = 0) THEN
			IF s.s = "plain" THEN style := "p"
			ELSIF s.s = "italic" THEN style := "i"
			ELSIF s.s = "bold" THEN style := "b"
			ELSE COPY(s.s, family)
			END;
			Change(t, beg, end, family, style, size)
		ELSIF (s.class = Texts.Int) & (s.line = 0) THEN
			size := SHORT(s.i);
			Change(t, beg, end, family, style, size)
		END
END Exec;
PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
	VAR e1: Elem;
BEGIN
	WITH e: Elem DO
		WITH
			m: Texts.CopyMsg DO
				NEW(e1); m.e := e1; PopupElems.Handle(e, m)
		|  m: Texts.IdentifyMsg DO
				m.mod := "FontElems"; m.proc := "Alloc"
		|  m: PopupElems.ExecMsg DO Exec(e, m.pos)
		ELSE PopupElems.Handle(e, m)
		END
END Handle;
PROCEDURE Alloc*;
	VAR e: Elem;
BEGIN
	NEW(e); e.handle := Handle; Texts.new := e
END Alloc;
PROCEDURE Insert*;
	VAR e: Elem; insert: TextFrames.InsertElemMsg;
BEGIN
	NEW(e); e.handle := Handle; e.name := "Font"; e.small := TRUE; 
	e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e);
	insert.e := e; Viewers.Broadcast(insert)
END Insert;
BEGIN
	ext := ".Scn.Fnt"
END FontElems.